home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / qbnws105.zip / DAZZLING.ZIP / DAZZLING.BAS < prev    next >
BASIC Source File  |  1990-11-22  |  16KB  |  422 lines
  1. '           +===================================================+
  2. '           |                   DAZZLING.BAS                    |
  3. '           |             Written and Developed by:             |
  4. '           |                  Lawrence Stone                   |
  5. '           |                                                   |
  6. '           |                Copyright (C), 1990                |
  7. '           |                   Lawrence Stone                  |
  8. '           |                All Rights Reserved                |
  9. '           |                                                   |
  10. '           |   The code in this module is for the exclusive    |
  11. '           |   use of readers of the QBNews or any QuickBASIC, |
  12. '           |   BASCOM, or PDS programmer.  The source code and |
  13. '           |   object modules derived from this code may be    |
  14. '           |   freely distributed without the express written  |
  15. '           |   permission of the author.                       |
  16. '           |                                                   |
  17. '           |   Donations of appreciation for this author's     |
  18. '           |   work are gladly accepted.  Please, no donations |
  19. '           |   over $10,000 <GRIN>.                            |
  20. '           |                                                   |
  21. '           |   Lawrence Stone               November 22, 1990  |
  22. '           |   P.O. Box 5715                                   |
  23. '           |   Charleston, OR  97420                           |
  24. '           +---------------------------------------------------+
  25. '
  26. '           +===================================================+
  27. '           |   Compile swithces:  bc dazzling /o;              |
  28. '           +---------------------------------------------------+
  29.  
  30. ' $INCLUDE: 'DAZZLING.BI'
  31.  
  32. SUB Curtains (Direction%, Arry%()) STATIC
  33.  
  34.     ' Arry%()           The screen image array.
  35.     '
  36.     ' Direction = odd   Curtains close from outside toward inside.
  37.     ' Direction = even  Curtains open from inside toward outside.
  38.     '
  39.     ' Monitor -+------  Must be DIM SHARED or COMMON SHARED in main module.
  40.     ' ScrnEls /
  41.     
  42.     Start = 79: finish = 159
  43.     StepCount = 2
  44.     start2 = 1: finish2 = ScrnEls * 2
  45.     StepCount2 = 160
  46.     Direction = Direction MOD 2         'Force Direction into a "1" or "0".
  47.  
  48.     IF Direction THEN
  49.         SWAP Start, finish
  50.         StepCount = -StepCount
  51.         SWAP start2, finish2
  52.         finish2 = finish2 - 1
  53.         StepCount2 = -StepCount2
  54.     END IF
  55.     
  56.     FOR N = Start TO finish STEP StepCount
  57.         DEF SEG = Monitor
  58.         FOR J = start2 TO finish2 STEP StepCount2
  59.             IF (N + J) \ 2 < ScrnEls THEN   'Prevents subscript out of range.
  60.                 '---- Right side of screen.
  61.                 OneByte = Arry((N + J) \ 2) AND &HFF       'Extract high byte.
  62.                 count = &H0 - Direction + J + N
  63.                 GOSUB CurtainPoke
  64.                 OneByte = (Arry((N + J) \ 2) AND &HFF00) \ 256   'Extract low.
  65.                 count = &H0 + 1 - Direction + N + J
  66.                 GOSUB CurtainPoke
  67.                 
  68.                 '---- Left side of screen.
  69.                 I = (79 - N) * 2
  70.                 OneByte = Arry((N + J + I) \ 2) AND &HFF    'Extract high byte.
  71.                 count = &H0 - Direction + J + I + N
  72.                 GOSUB CurtainPoke
  73.                 OneByte = (Arry((N + J + I) \ 2) AND &HFF00) \ 256'Extract low.
  74.                 count = &H0 + 1 - Direction + N + J + I
  75.                 GOSUB CurtainPoke
  76.             END IF
  77.         NEXT
  78.         DEF SEG  'We must return to BASIC's segment before we call TickPause.
  79.         IF N MOD 3 THEN TickPause 1   'A short delay for effect.
  80.     NEXT
  81.  
  82.     EXIT SUB
  83.  
  84. CurtainPoke:
  85.     POKE count, OneByte
  86. RETURN
  87.  
  88. END SUB
  89.  
  90. SUB Dazzle (Operation%, Direction%, Arry%()) STATIC
  91.  
  92.     ' Operation         Description
  93.     ' ---------         ---------------------------------
  94.     '     0             Pull Full Screen Restore
  95.     '     1             Dazzled with Stair Steps
  96.     '     2             Dazzled with 8 Vertical Blinds
  97.     '     3             Dazzled with 4 Vertical Blinds
  98.     '     4             Dazzled with Slots
  99.     '     5             Dazzled with Diagonal Fills
  100.     '     6             Dazzled with Side Slides
  101.     '     7             Dazzled with Rolling Grates
  102.     '     8             Dazzled with Venetian Blinds
  103.     '
  104.     ' Direction = odd   Screen restore is left to right or, top to bottom
  105.     ' Direction = even  Screen restore is right to left or, bottom to top
  106.     '
  107.     ' Arry%()           Screen array
  108.     '
  109.     ' MaxLine \
  110.     ' Monitor -+------  Must be DIM SHARED or COMMON SHARED in main module.
  111.     ' ScrnEls /
  112.  
  113.     GOSUB InitDazzle
  114.     
  115.     FOR J = Start TO finish STEP StepCount   'Force a dazzle.
  116.         DEF SEG = Monitor                    'Define segment address.
  117.         FOR N = J TO finish2 STEP StepCount2
  118.             High = Arry(N \ 2) AND &HFF              'Extract the high byte.
  119.             Low = (Arry(N \ 2) AND &HFF00) \ 256     'Extract the low byte.
  120.             POKE &H0 - 1 + N, High           'POKE the high byte (color attr).
  121.             POKE &H0 + N, Low                'POKE the low byte (character).
  122.  
  123.             ' Slow pull down/up windows needed for compiled code if you
  124.             ' don't want it to just "flash" onto the monitor.
  125.             IF Operation = 0 AND N MOD 479 = 0 THEN
  126.                 DEF SEG
  127.                 TickPause 1
  128.                 DEF SEG = Monitor
  129.             END IF
  130.  
  131.         NEXT
  132.         DEF SEG                              'Back to BASIC.
  133.  
  134.         '**** Short Pause for added effect.
  135.         IF Operation < 4 THEN
  136.             TickPause 1
  137.         ELSEIF Operation > 7 THEN
  138.             IF J MOD 199 = 0 THEN TickPause 1
  139.         ELSEIF Operation = 7 THEN
  140.             IF J MOD 7 = 0 THEN TickPause 1
  141.         ELSEIF Operation <> 0 THEN
  142.             IF J MOD 3 = 0 THEN TickPause 1
  143.         END IF
  144.     NEXT
  145.     
  146.     EXIT SUB
  147.  
  148. InitDazzle:
  149.     StepCount = 2: Start = 1: finish2 = ScrnEls * 2
  150.     SELECT CASE Operation
  151.         CASE 0          'Pull Full Screen Restore
  152.             finish = 1: StepCount2 = finish + 1
  153.             IF Direction MOD 2 THEN
  154.                 Start = finish2 + 1: finish = Start
  155.                 finish2 = 0: StepCount2 = -StepCount2
  156.             END IF
  157.         CASE 1                      'Dazzled Stair Steps
  158.             finish = 42: StepCount2 = finish - 4
  159.         CASE 2                      'Dazzled with 8 Vertical Blinds
  160.             finish = 20: StepCount2 = finish
  161.         CASE 3                      'Dazzled with 4 Vertical Blinds
  162.             finish = 40:  StepCount2 = finish
  163.         CASE 4                      'Dazzled with Slots
  164.             finish = 119:  StepCount2 = finish - 1
  165.         CASE 5                      'Dazzled by Diagonal Fills
  166.             finish = 82: StepCount2 = finish
  167.         CASE 6                      'Dazzled by Side Slides
  168.             finish = 160: StepCount2 = finish
  169.         CASE 7                      'Dazzled by Rolling Grates
  170.             finish = 320: StepCount2 = finish
  171.         CASE 8                      'Dazzled with Venetian Blinds
  172.             finish = 80 * MaxLine - MaxLine
  173.             finish = finish - (finish MOD 160) + 160
  174.             StepCount2 = finish
  175.             StepCount2 = StepCount2 + (StepCount2 MOD 80)
  176.         CASE ELSE
  177.     END SELECT
  178.  
  179.     IF Direction MOD 2 = 0 AND Operation% <> 0 THEN
  180.         SWAP Start, finish
  181.         IF NOT Operation = 4 THEN Start = Start - 1
  182.         StepCount = -StepCount
  183.     END IF
  184. RETURN
  185.  
  186. END SUB
  187.  
  188. SUB GetMonitorSeg
  189.  
  190.     ' Monitor       Must be DIM SHARED or COMMON SHARED in main module.
  191.  
  192.     DEF SEG = 0
  193.     IF (PEEK(&H410) AND &H30) = &H30 THEN Monitor = &HB000 ELSE Monitor = &HB800
  194.     DEF SEG
  195.  
  196. END SUB
  197.  
  198. SUB Implode (Arry%()) STATIC
  199.  
  200.     ' Arry%()           The screen image array.
  201.     '
  202.     ' Direction = odd   Curtains close from outside toward inside.
  203.     ' Direction = even  Curtains open from inside toward outside.
  204.     '
  205.     ' Monitor -+------  Must be DIM SHARED or COMM